home *** CD-ROM | disk | FTP | other *** search
- {Copyright John O'Connell 1996. All rights reserved}
- unit Infotab;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, DB, DBTables, DbiProcs, DbiTypes;
-
- type
- TInfoType = (itNothing, itFamily, itPhysFields, itLogFields, itIndex, itRefInt,
- itTables, itValChecks);
- TCfgType = (ctUsers, ctDatabases, ctDrivers, ctTableTypes, ctFieldTypes,
- ctIndexTypes, ctLanguageDrivers);
- TDriverType = (dtParadox, dtDbase, dtAscii, dtInterbase, dtOracle);
-
- TIdapiCfg = class(TDataset)
- private
- { Private declarations }
- FCfgType: TCfgType;
- FDriverType: TDriverType;
- procedure SetCfgType(const Value: TCfgType);
- procedure SetDriver(const Value: TDriverType);
- protected
- { Protected declarations }
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- function CreateHandle: HDbiCur; override;
- published
- { Published declarations }
- property ConfigInfo: TCfgType read FCfgType write SetCfgType default ctUsers;
- property DriverType: TDriverType read FDriverType write SetDriver default dtParadox;
- end;
-
- TDBUserList = class(TDBDataset)
- private
- { Private declarations }
- protected
- { Protected declarations }
- public
- { Public declarations }
- function CreateHandle: HDbiCur; override;
- published
- { Published declarations }
- end;
-
- TTableLocks = class(TDataset)
- private
- { Private declarations }
- FAllUsers: Boolean;
- FAllLockTypes: Boolean;
- FDataLink: TFieldDataLink;
- procedure SetDataSource(const Value: TDataSource);
- function GetDataSource: TDataSource;
- function CanOpenLockList: Boolean;
- procedure DoActiveChanged(Sender: TObject);
- protected
- { Protected declarations }
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function CreateHandle: HDbiCur; override;
- published
- { Published declarations }
- property DataSource: TDataSource read GetDataSource write SetDataSource;
- property AllUsers: boolean read FAllUsers write FAllUsers default True;
- property AllLockTypes: boolean read FAllLockTypes write FAllLockTypes default True;
- end;
-
- TTableInfo = class(TTable)
- private
- { Private declarations }
- FInfoType: TInfoType;
- FDriverType: TDriverType;
- procedure SetInfoType(const Value: TInfoType);
- procedure SetDriver(const Value: TDriverType);
- protected
- { Protected declarations }
- public
- { Public declarations }
- constructor Create(AOwner: TComponent); override;
- function CreateHandle: HDbiCur; override;
- published
- { Published declarations }
- property TableInfo: TInfoType read FInfoType write SetInfoType default itNothing;
- property DriverType: TDriverType read FDriverType write SetDriver default dtParadox;
- end;
-
- procedure Register;
-
- implementation
-
- const Driver: array[TDriverType] of PChar = (szPARADOX, szDBASE, szASCII,
- 'INTRBASE','ORACLE');
-
- { TIdapiCfg }
-
- constructor TIdapiCfg.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FCfgType := ctUsers;
- FDriverType := dtParadox;
- end;
-
- function TIdapiCfg.CreateHandle: HDbiCur;
- begin
- Result := nil;
- case FCfgType of
- ctUsers: Check(DbiOpenUserList(Result));
- ctDatabases: Check(DbiOpenDatabaseList(Result));
- ctDrivers: Check(DbiOpenDriverList(Result));
- ctLanguageDrivers: Check(DbiOpenLdList(Result));
- ctTableTypes: Check(DbiOpenTableTypesList(Driver[FDriverType],Result));
- ctFieldTypes: Check(DbiOpenFieldTypesList(Driver[FDriverType],nil,Result));
- ctIndexTypes: Check(DbiOpenIndexTypesList(Driver[FDriverType],Result));
- end;
- end;
-
- procedure TIdapiCfg.SetDriver(const Value: TDriverType);
- begin
- CheckInactive;
- FDriverType := Value;
- end;
-
- procedure TIdapiCfg.SetCfgType(const Value: TCfgType);
- begin
- CheckInactive;
- FCfgType := Value;
- end;
-
- { TDBUserList }
-
- function TDBUserList.CreateHandle: HDbiCur;
- begin
- Result := nil;
- Check(DbiOpenUserList(Result));
- end;
-
- { TTableLocks }
-
- constructor TTableLocks.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FDataLink := TFieldDataLink.Create;
- FDataLink.OnActiveChange := DoActiveChanged;
- FDataLink.OnDataChange := nil;
- FAllUsers := True;
- FAllLockTypes := True;
- end;
-
- destructor TTableLocks.Destroy;
- begin
- FDataLink.OnActiveChange := nil;
- FDataLink.Free;
- inherited Destroy;
- end;
-
- procedure TTableLocks.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (Operation = opRemove) and (FDataLink <> nil) and
- (AComponent = DataSource) then DataSource := nil;
- end;
-
- function TTableLocks.CanOpenLockList: Boolean;
- begin
- Result := (DataSource <> nil) and
- (DataSource.DataSet <> nil) and
- (DataSource.DataSet.Active);
- end;
-
- function TTableLocks.CreateHandle: HDbiCur;
- begin
- Result := nil;
- if CanOpenLockList then
- with FDataLink.DataSet do
- Check(DbiOpenLockList(Handle, FAllUsers, FAllLockTypes, Result));
- end;
-
- procedure TTableLocks.SetDataSource(const Value: TDataSource);
- begin
- if (Value = nil) then
- FDataLink.DataSource := Value
- else
- if (Value.DataSet = nil) then
- FDataLink.DataSource := Value
- else
- if (Value.DataSet.InheritsFrom(TTable)) then
- FDataLink.DataSource := Value
- else
- raise EInvalidOperation.Create ('Dataset is not a TTable');
- end;
-
- function TTableLocks.GetDataSource: TDataSource;
- begin
- Result := FDataLink.DataSource;
- end;
-
- procedure TTableLocks.DoActiveChanged(Sender: TObject);
- begin
- if DataSource = nil then
- Close
- else
- with DataSource do
- if (DataSet = nil) then
- Close
- else if not DataSet.Active then
- Close;
- end;
-
- {TTableInfo}
-
- constructor TTableInfo.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FInfoType := itNothing;
- FDriverType := dtParadox;
- end;
-
- function TTableInfo.CreateHandle: HDbiCur;
- var TabName: array[0..DBIMAXNAMELEN] of char;
- hDB: HDBIDb;
- begin
- Result := nil;
- hDB := Database.Handle;
- StrPCopy(TabName, TableName);
-
- if (FInfoType = itNothing) then
- Result := inherited CreateHandle
- else
- case FInfoType of
- itFamily : Check(DbiOpenFamilyList(hDb, TabName, Driver[FDriverType], Result));
- itPhysFields: Check(DbiOpenFieldList(hDb, TabName, Driver[FDriverType],
- True, Result));
- itLogFields : Check(DbiOpenFieldList(hDb, TabName, Driver[FDriverType],
- False, Result));
- itIndex : Check(DbiOpenIndexList(hDb, TabName, Driver[FDriverType], Result));
- itRefInt : Check(DbiOpenRintList(hDb, TabName, Driver[FDriverType], Result));
- itTables : Check(DbiOpenTableList(hDb, True, True, nil, Result));
- itValChecks : Check(DbiOpenVchkList(hDb, TabName, Driver[FDriverType], Result));
- end;
- end;
-
- procedure TTableInfo.SetDriver(const Value: TDriverType);
- begin
- CheckInactive;
- FDriverType := Value;
- end;
-
- procedure TTableInfo.SetInfoType(const Value: TInfoType);
- begin
- CheckInactive;
- FInfoType := Value;
- end;
-
- procedure Register;
- begin
- RegisterComponents('JOC', [TIdapiCfg, TDBUserList, TTableLocks, TTableInfo]);
- end;
-
- end.
-